--- Merging r34818 into '.':

U    packages/fcl-json/tests/testjsonrtti.pp
--- Recording mergeinfo for merge of r34818 into '.':
 U   .
--- Merging r34819 into '.':
U    packages/fcl-json/tests/testjsondata.pp
U    packages/fcl-json/src/fpjson.pp
--- Recording mergeinfo for merge of r34819 into '.':
 G   .
--- Merging r34851 into '.':
U    packages/pastojs/tests/tcconverter.pp
U    packages/pastojs/src/fppas2js.pp
U    packages/fcl-js/src/jsbase.pp
U    packages/fcl-js/src/jswriter.pp
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r34851 into '.':
 G   .
--- Merging r34859 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Recording mergeinfo for merge of r34859 into '.':
 G   .
--- Merging r34860 into '.':
G    packages/fcl-json/tests/testjsonrtti.pp
U    packages/fcl-json/tests/testjson.lpi
U    packages/fcl-json/tests/testcomps.pp
G    packages/fcl-json/tests/testjsondata.pp
--- Recording mergeinfo for merge of r34860 into '.':
 G   .
--- Merging r34869 into '.':
U    packages/fcl-json/src/jsonscanner.pp
U    packages/fcl-json/src/jsonparser.pp
--- Recording mergeinfo for merge of r34869 into '.':
 G   .
--- Merging r34870 into '.':
U    packages/fcl-json/src/jsonconf.pp
U    packages/fcl-json/tests/jsonconftest.pp
--- Recording mergeinfo for merge of r34870 into '.':
 G   .
--- Merging r34875 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
A    packages/fcl-web/examples/httpclient/keepalive.pp
A    packages/fcl-web/examples/httpclient/keepalive.lpi
--- Recording mergeinfo for merge of r34875 into '.':
 G   .
--- Merging r35022 into '.':
U    packages/rtl-extra/src/unix/clocale.pp
U    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-js/src/jswriter.pp
U    packages/fcl-js/src/jstree.pp
--- Recording mergeinfo for merge of r35022 into '.':
 G   .
--- Merging r35023 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-js/src/jswriter.pp
G    packages/fcl-js/src/jstree.pp
G    packages/rtl-extra/src/unix/clocale.pp
--- Recording mergeinfo for merge of r35023 into '.':
 G   .
--- Merging r35055 into '.':
G    packages/fcl-js/src/jswriter.pp
U    packages/fcl-js/src/jstree.pp
G    packages/pastojs/src/fppas2js.pp
U    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35055 into '.':
 G   .
--- Merging r35121 into '.':
U    packages/fpgtk/src/fpgtkext.pp
U    packages/fpmkunit/src/fpmkunit.pp
U    packages/fcl-web/src/base/iniwebsession.pp
U    packages/winunits-base/src/commctrl.pp
U    packages/winunits-base/src/dwmapi.pp
U    packages/winunits-jedi/src/jwawinwlx.pas
U    packages/winunits-jedi/src/jwawinbase.pas
U    packages/winunits-jedi/src/jwaimagehlp.pas
U    packages/winunits-jedi/src/jwawinioctl.pas
--- Recording mergeinfo for merge of r35121 into '.':
 G   .
--- Merging r35166 into '.':
U    packages/fcl-js/tests/tcscanner.pp
U    packages/fcl-js/tests/tcparser.pp
U    packages/fcl-js/tests/tcwriter.pp
U    packages/fcl-js/src/jsscanner.pp
U    packages/fcl-js/src/jsparser.pp
G    packages/fcl-js/src/jswriter.pp
U    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
U    packages/fcl-passrc/tests/tcresolver.pas
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35166 into '.':
 G   .

# revisions: 34818,34819,34851,34859,34860,34869,34870,34875,35022,35023,35055,35121,35166

git-svn-id: branches/fixes_3_0@35980 -

.gitattributes

@@ -3075,6 +3075,8 @@ packages/fcl-web/examples/httpclient/httppost.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppost.pp svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpclient/httppostfile.pp svneol=native#text/plain
+packages/fcl-web/examples/httpclient/keepalive.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpclient/keepalive.pp svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain
 packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain

packages/fcl-js/src/jsbase.pp

@@ -25,7 +25,7 @@ uses
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,JSTCompletion);
 
-  TJSString = WideString;
+  TJSString = UnicodeString;
   TJSNumber = Double;
 
   { TJSValue }
@@ -39,6 +39,7 @@ Type
       1 : (F : TJSNumber);
       2 : (I : Integer);
     end;
+    FCustomValue: TJSString;
     procedure ClearValue(ANewValue: TJSType);
     function GetAsBoolean: Boolean;
     function GetAsCompletion: TObject;
@@ -64,6 +65,7 @@ Type
     Constructor Create(AString: TJSString);
     Destructor Destroy; override;
     Property ValueType : TJSType Read FValueType;
+    Property CustomValue: TJSString Read FCustomValue Write FCustomValue;
     Property IsUndefined : Boolean Read GetIsUndefined Write SetIsUndefined;
     Property IsNull : Boolean Read GetIsNull Write SetIsNull;
     Property AsNumber : TJSNumber Read GetAsNumber Write SetAsNumber;
@@ -144,6 +146,7 @@ begin
     FValue.I:=0;
   end;
   FValueType:=ANewValue;
+  FCustomValue:='';
 end;
 
 procedure TJSValue.SetAsBoolean(const AValue: Boolean);
@@ -184,40 +187,46 @@ end;
 
 procedure TJSValue.SetIsNull(const AValue: Boolean);
 begin
-  ClearValue(jstNull);
+  if AValue then
+    ClearValue(jstNull)
+  else if IsNull then
+    ClearValue(jstUNDEFINED);
 end;
 
 procedure TJSValue.SetIsUndefined(const AValue: Boolean);
 begin
-  ClearValue(jstUndefined);
+  if AValue then
+    ClearValue(jstUndefined)
+  else if IsUndefined then
+    ClearValue(jstNull);
 end;
 
-Constructor TJSValue.CreateNull;
+constructor TJSValue.CreateNull;
 begin
   IsNull:=True;
 end;
 
-Constructor TJSValue.Create;
+constructor TJSValue.Create;
 begin
   IsUndefined:=True;
 end;
 
-Constructor TJSValue.Create(ANumber: TJSNumber);
+constructor TJSValue.Create(ANumber: TJSNumber);
 begin
   AsNumber:=ANumber;
 end;
 
-Constructor TJSValue.Create(ABoolean: Boolean);
+constructor TJSValue.Create(ABoolean: Boolean);
 begin
   AsBoolean:=ABoolean;
 end;
 
-Constructor TJSValue.Create(AString: TJSString);
+constructor TJSValue.Create(AString: TJSString);
 begin
   AsString:=AString;
 end;
 
-Destructor TJSValue.Destroy;
+destructor TJSValue.Destroy;
 begin
   ClearValue(jstUndefined);
   inherited Destroy;

packages/fcl-js/src/jsparser.pp

@@ -153,7 +153,7 @@ Resourcestring
   SErrCatchFinallyExpected   = 'Unexpected token: Expected ''catch'' or ''finally''';
   SErrArgumentsExpected      = 'Unexpected token: Expected '','' or '')'', got %s';
   SErrArrayEnd               = 'Unexpected token: Expected '','' or '']'', got %s';
-  SErrObjectEnd              = 'Unexpected token: Expected '','' or ''}'', got %s';
+  //SErrObjectEnd              = 'Unexpected token: Expected '','' or ''}'', got %s';
   SErrObjectElement          = 'Unexpected token: Expected string, identifier or number after '','' got: %s';
   SErrLiteralExpected        = 'Unexpected token: Expected: null, true, false, number, string, or regex, got: %s';
   SErrInvalidnumber          = 'Invalid numerical value: %s';
@@ -188,6 +188,7 @@ begin
     FCurrent:=FScanner.FetchToken;
     FCurrentString:=FScanner.CurTokenString;
     end;
+  Result:=FCurrent;
   {$ifdef debugparser}Writeln('GetNextToken (',FScanner.CurLine,',',FScanner.CurColumn,'): ',GetEnumName(TypeInfo(TJSToken),Ord(FCurrent)), ' As string: ',FCurrentString);{$endif debugparser}
 end;
 
@@ -1816,6 +1817,7 @@ begin
         end
       else
         n:='';
+      if n='' then ; // what to do with that?
       Consume(tjsBraceOpen);
       F.AFunction:= TJSFuncDef.Create;
       Args:=ParseFormalParameterList;

packages/fcl-js/src/jsscanner.pp

@@ -79,7 +79,6 @@ Type
     FCurToken: TJSToken;
     FCurTokenString: string;
     FCurLine: string;
-    FDefines: TStrings;
     TokenStr: PChar;
     FWasEndOfLine : Boolean;
     FSourceStream : TStream;
@@ -377,7 +376,7 @@ function TJSScanner.DoStringLiteral: TJSToken;
 Var
   Delim : Char;
   TokenStart : PChar;
-  Len,OLen,I : Integer;
+  Len,OLen: Integer;
   S : String;
 
 begin
@@ -522,12 +521,6 @@ end;
 
 Function TJSScanner.FetchToken: TJSToken;
 
-
-var
-  TokenStart, CurPos: PChar;
-  i: TJSToken;
-  OldLength, SectionLength, NestingLevel, Index: Integer;
-
 begin
   if not (FCurtoken in [tjsWhiteSpace,tjsComment]) then
     FWasEndOfLine:=False;
@@ -541,7 +534,7 @@ begin
         exit;
         end;
       end;
-    CurPos:=TokenStr;
+    //CurPos:=TokenStr;
     FCurTokenString := '';
     case TokenStr[0] of
       #0:         // Empty line

packages/fcl-js/src/jstree.pp

@@ -883,7 +883,7 @@ Type
     Destructor Destroy; override;
     Property Cond : TJSelement Read FCond Write FCond;
     Property Cases : TJSCaseElements Read FCases;
-    Property TheDefault : TJSCaseelement Read FDefault Write FDefault; // one of Cases
+    Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases
   end;
 
   { TJSLabeledStatement - e.g. 'TheLabel : A' }

packages/fcl-js/src/jswriter.pp

@@ -136,7 +136,7 @@ Type
     Procedure WriteIfStatement(El: TJSIfStatement);virtual;
     Procedure WriteSourceElements(El: TJSSourceElements);virtual;
     Procedure WriteStatementList(El: TJSStatementList);virtual;
-    Procedure WriteTryStatement(el: TJSTryStatement);virtual;
+    Procedure WriteTryStatement(El: TJSTryStatement);virtual;
     Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual;
     Procedure WriteWithStatement(El: TJSWithStatement);virtual;
     Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual;
@@ -144,7 +144,7 @@ Type
     Procedure WriteFunctionBody(El: TJSFunctionBody);virtual;
     Procedure WriteFunctionDeclarationStatement(El: TJSFunctionDeclarationStatement);virtual;
     Procedure WriteLabeledStatement(El: TJSLabeledStatement);virtual;
-    Procedure WriteReturnStatement(EL: TJSReturnStatement);virtual;
+    Procedure WriteReturnStatement(El: TJSReturnStatement);virtual;
     Procedure WriteTargetStatement(El: TJSTargetStatement);virtual;
     Procedure WriteFuncDef(FD: TJSFuncDef);virtual;
     Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual;
@@ -222,6 +222,7 @@ Var
 
 begin
   Result:=Length(S)*SizeOf(Char);
+  if Result=0 then exit;
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
@@ -241,6 +242,7 @@ Var
 
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
+  if Result=0 then exit;
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
@@ -425,20 +427,23 @@ procedure TJSWriter.WriteValue(V: TJSValue);
 Var
   S : String;
 begin
-  Case V.ValueType of
-     jstUNDEFINED : S:='undefined';
-     jstNull : s:='null';
-     jstBoolean : if V.AsBoolean then s:='true' else s:='false';
-     jstString : S:='"'+EscapeString(V.AsString)+'"';
-     jstNumber :
-       if Frac(V.AsNumber)=0 then // this needs to be improved
-         Str(Round(V.AsNumber),S)
-       else
-         Str(V.AsNumber,S);
-     jstObject : ;
-     jstReference : ;
-     JSTCompletion : ;
-  end;
+  if V.CustomValue<>'' then
+    S:=JSStringToStr(V.CustomValue)
+  else
+    Case V.ValueType of
+      jstUNDEFINED : S:='undefined';
+      jstNull : s:='null';
+      jstBoolean : if V.AsBoolean then s:='true' else s:='false';
+      jstString : S:='"'+EscapeString(V.AsString)+'"';
+      jstNumber :
+        if Frac(V.AsNumber)=0 then // this needs to be improved
+          Str(Round(V.AsNumber),S)
+        else
+          Str(V.AsNumber,S);
+      jstObject : ;
+      jstReference : ;
+      JSTCompletion : ;
+    end;
   Write(S);
 end;
 
@@ -560,45 +565,46 @@ end;
 
 procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
 
-
-
 Var
   Chars : Array[Boolean] of string[2] = ('[]','()');
 
 Var
   i,C : Integer;
-  isArgs,WC : Boolean;
+  isArgs,WC , MultiLine: Boolean;
   BC : String[2];
 
 begin
-  isArgs:=el is TJSArguments;
+  isArgs:=El is TJSArguments;
   BC:=Chars[isArgs];
-  C:=EL.Elements.Count-1;
+  C:=El.Elements.Count-1;
   if C=-1 then
     begin
-    if isArgs then
-      Write(bc)
-    else
-      Write(bc);
+    Write(bc);
     Exit;
     end;
   WC:=(woCompact in Options) or
       ((Not isArgs) and (woCompactArrayLiterals in Options)) or
       (isArgs and (woCompactArguments in Options)) ;
-  if WC then
-    Write(Copy(BC,1,1))
-  else
+  MultiLine:=(not WC) and (C>4);
+  if MultiLine then
     begin
     Writeln(Copy(BC,1,1));
     Indent;
-    end;
+    end
+  else
+    Write(Copy(BC,1,1));
   For I:=0 to C do
-   begin
-   WriteJS(EL.Elements[i].Expr);
-   if I<C then
-     if WC then Write(', ') else Writeln(',')
-   end;
-  if not WC then
+    begin
+    WriteJS(El.Elements[i].Expr);
+    if I<C then
+      if WC then
+        Write(',')
+      else if MultiLine then
+        Writeln(',')
+      else
+        Write(', ');
+    end;
+  if MultiLine then
     begin
     Writeln('');
     Undent;
@@ -682,7 +688,7 @@ procedure TJSWriter.WriteCallExpression(El: TJSCallExpression);
 begin
   WriteJS(El.Expr);
   if Assigned(El.Args) then
-    WriteArrayLiteral(EL.Args)
+    WriteArrayLiteral(El.Args)
   else
     Write('()');
 end;
@@ -818,7 +824,7 @@ begin
   WriteJS(EL.LHS);
   S:=El.OperatorString;
   If Not (woCompact in Options) then
-      S:=' '+S+' ';
+    S:=' '+S+' ';
   Write(s);
   WriteJS(EL.Expr);
 end;
@@ -838,11 +844,16 @@ procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
 
 begin
   Write('if (');
-  WriteJS(EL.Cond);
-  Write(') ');
-  WriteJS(El.BTrue);
+  WriteJS(El.Cond);
+  Write(')');
+  If Not (woCompact in Options) then
+    Write(' ');
+  if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then
+    WriteJS(El.BTrue);
   if Assigned(El.BFalse) then
     begin
+    if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then
+      Write('{}');
     Write(' else ');
     WriteJS(El.BFalse)
     end;
@@ -926,15 +937,15 @@ begin
   C:=(woCompact in Options);
   Write('switch (');
   If Assigned(El.Cond) then
-    WriteJS(EL.Cond);
+    WriteJS(El.Cond);
   if C then
     Write(') {')
   else
     Writeln(') {');
-  For I:=0 to EL.Cases.Count-1 do
+  For I:=0 to El.Cases.Count-1 do
     begin
-    EC:=EL.Cases[i];
-    if EC=EL.TheDefault then
+    EC:=El.Cases[i];
+    if EC=El.TheDefault then
       Write('default')
     else
       begin
@@ -947,14 +958,22 @@ begin
       Writeln(':');
     if Assigned(EC.Body) then
       begin
+      FSkipBrackets:=true;
+      Indent;
       WriteJS(EC.Body);
+      Undent;
+      if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
+        if C then
+          Write('; ')
+        else
+          Writeln(';');
+      end
+    else
+      begin
       if C then
-        begin
-        if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
-          write('; ')
-        end
+        Write('; ')
       else
-        Writeln('');
+        Writeln(';');
       end;
     end;
   Write('}');
@@ -993,11 +1012,16 @@ begin
     Error('Unknown target statement class: "%s"',[EL.ClassName])
 end;
 
-procedure TJSWriter.WriteReturnStatement(EL: TJSReturnStatement);
+procedure TJSWriter.WriteReturnStatement(El: TJSReturnStatement);
 
 begin
-  Write('return ');
-  WriteJS(EL.Expr);
+  if El.Expr=nil then
+    Write('return')
+  else
+    begin
+    Write('return ');
+    WriteJS(El.Expr);
+    end;
 end;
 
 procedure TJSWriter.WriteLabeledStatement(El: TJSLabeledStatement);
@@ -1014,7 +1038,7 @@ begin
   WriteJS(EL.A);
 end;
 
-procedure TJSWriter.WriteTryStatement(el: TJSTryStatement);
+procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
 
 Var
   C : Boolean;
@@ -1031,7 +1055,6 @@ begin
     Write('} ')
   else
     begin
-    Writeln('');
     Writeln('}');
     end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
@@ -1042,7 +1065,7 @@ begin
     else
       Writeln(') {');
     Indent;
-    WriteJS(EL.BCatch);
+    WriteJS(El.BCatch);
     Undent;
     If C then
       if (El is TJSTryCatchFinallyStatement) then
@@ -1062,15 +1085,10 @@ begin
     else
       Writeln('finally {');
     Indent;
-    WriteJS(EL.BFinally);
+    FSkipBrackets:=True;
+    WriteJS(El.BFinally);
     Undent;
-    If C then
-      Write('}')
-    else
-      begin
-      Writeln('');
-      Writeln('}');
-      end;
+    Write('}');
     end;
 end;
 

packages/fcl-js/tests/tcparser.pp

@@ -5,7 +5,7 @@ unit tcparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, jsParser, jstree, jsbase;
+  Classes, SysUtils, fpcunit, testregistry, jsParser, jstree, jsbase;
 
 type
 
@@ -172,9 +172,6 @@ Function TTestJSParser.GetFirstStatement: TJSElement;
 
 Var
   E : TJSElementNodes;
-  N : TJSElement;
-  X : TJSExpressionStatement;
-
 begin
   E:=GetStatements;
   AssertNotNull('Have statements',E);
@@ -186,8 +183,6 @@ end;
 Function TTestJSParser.GetFirstVar: TJSElement;
 Var
   E : TJSElementNodes;
-  N : TJSElement;
-  X : TJSExpressionStatement;
 begin
   E:=GetVars;
   AssertNotNull('Have statements',E);
@@ -202,8 +197,6 @@ Function TTestJSParser.GetExpressionStatement: TJSExpressionStatement;
 
 Var
   N : TJSElement;
-  X : TJSExpressionStatement;
-
 begin
   N:=GetFirstStatement;
   CheckClass(N,TJSExpressionStatement);
@@ -2247,8 +2240,6 @@ procedure TTestJSParser.TestSwitchEmpty;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
-
 begin
   CreateParser('switch (a) {}');
   E:=GetFirstStatement;
@@ -2265,7 +2256,6 @@ procedure TTestJSParser.TestSwitchOne;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c : {}}');
@@ -2286,7 +2276,6 @@ procedure TTestJSParser.TestSwitchTwo;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c: {}'+sLineBreak+' case d: {}}');
@@ -2310,7 +2299,6 @@ procedure TTestJSParser.TestSwitchTwoDefault;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c: {} case d: {} default: {}}');

packages/fcl-js/tests/tcscanner.pp

@@ -5,7 +5,7 @@ unit tcscanner;
 interface
 
 uses
-  Classes, SysUtils, Typinfo, fpcunit, testutils, testregistry, jstoken, jsscanner;
+  Classes, SysUtils, Typinfo, fpcunit, testregistry, jstoken, jsscanner;
 
 type
 
@@ -190,7 +190,6 @@ end;
 procedure TTestJSScanner.AssertEquals(AMessage : String; AExpected, AActual: TJSToken);
 
 Var
-  J : TJSToken;
   S,EN1,EN2 : String;
 
 begin
@@ -857,7 +856,6 @@ procedure TTestJSScanner.DoTestString(S: String);
 
 Var
   J : TJSToken;
-  T : String;
 begin
   CreateScanner(S);
   try

packages/fcl-js/tests/tcwriter.pp

@@ -2430,7 +2430,6 @@ end;
 
 
 Initialization
-
   RegisterTests([TTestTestJSWriter,TTestLiteralWriter,TTestExpressionWriter,TTestStatementWriter]);
 end.
 

packages/fcl-json/src/fpjson.pp

@@ -283,6 +283,8 @@ Type
     function GetAsJSON: TJSONStringType; override;
     function GetAsString: TJSONStringType; override;
     procedure SetAsString(const AValue: TJSONStringType); override;
+  Public
+    Class var StrictEscaping : Boolean;
   public
     Constructor Create(const AValue : TJSONStringType); reintroduce;
     Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
@@ -588,7 +590,7 @@ Type
 Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
 Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
 
-Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
+Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
 Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
 Function JSONTypeName(JSONType : TJSONType) : String;
 
@@ -599,10 +601,10 @@ Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
 Function CreateJSON(Data : Int64) : TJSONInt64Number;
 Function CreateJSON(Data : QWord) : TJSONQWordNumber;
 Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
-Function CreateJSON(Data : TJSONStringType) : TJSONString;
-Function CreateJSON(Data : TJSONUnicodeStringType) : TJSONString;
-Function CreateJSONArray(Data : Array of const) : TJSONArray;
-Function CreateJSONObject(Data : Array of const) : TJSONObject;
+Function CreateJSON(const Data : TJSONStringType) : TJSONString;
+Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
+Function CreateJSONArray(const Data : Array of const) : TJSONArray;
+Function CreateJSONObject(const Data : Array of const) : TJSONObject;
 
 // These functions rely on a callback. If the callback is not set, they will raise an error.
 // When the jsonparser unit is included in the project, the callback is automatically set.
@@ -662,7 +664,7 @@ begin
   Result:=DefaultJSONInstanceTypes[AType]
 end;
 
-function StringToJSONString(const S: TJSONStringType): TJSONStringType;
+function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
 
 Var
   I,J,L : Integer;
@@ -683,7 +685,10 @@ begin
       Result:=Result+Copy(S,J,I-J);
       Case C of
         '\' : Result:=Result+'\\';
-        '/' : Result:=Result+'\/';
+        '/' : if Strict then
+                Result:=Result+'\/'
+              else
+                Result:=Result+'/';
         '"' : Result:=Result+'\"';
         #8  : Result:=Result+'\b';
         #9  : Result:=Result+'\t';
@@ -782,31 +787,30 @@ begin
   Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
 end;
 
-function CreateJSON(Data: TJSONStringType): TJSONString;
+function CreateJSON(const Data: TJSONStringType): TJSONString;
 begin
   Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
 end;
 
-function CreateJSON(Data: TJSONUnicodeStringType): TJSONString;
+function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
 begin
   Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
 end;
 
-function CreateJSONArray(Data: array of const): TJSONArray;
+function CreateJSONArray(const Data: array of const): TJSONArray;
 begin
   Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
 end;
 
-function CreateJSONObject(Data: array of const): TJSONObject;
+function CreateJSONObject(const Data: array of const): TJSONObject;
 begin
-  Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
+  Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
 end;
 
 Var
   JPH : TJSONParserHandler;
 
-function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean
-  ): TJSONData;
+function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
 
 Var
   SS : TStringStream;
@@ -1087,7 +1091,7 @@ begin
         if (I>0) then
           W(',');
         W('"');
-        W(StringToJSONString(O.Names[i]));
+        W(StringToJSONString(O.Names[i],False));
         W('":');
         O.Items[I].DumpJSON(S);
         end;
@@ -1304,7 +1308,7 @@ end;
 
 function TJSONString.GetAsJSON: TJSONStringType;
 begin
-  Result:='"'+StringToJSONString(FValue)+'"';
+  Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
 end;
 
 function TJSONString.GetAsString: TJSONStringType;

packages/fcl-json/src/jsonconf.pp

@@ -637,6 +637,7 @@ begin
         Node.Delete(L);
       end;
     end;
+  FModified:=True;  
 end;
 
 procedure TJSONConfig.DeleteValue(const APath: UnicodeString);

packages/fcl-json/src/jsonparser.pp

@@ -29,7 +29,7 @@ Type
   Private
     FScanner : TJSONScanner;
     function GetO(AIndex: TJSONOption): Boolean;
-    function GetOptions: TJSONOptions;
+    function GetOptions: TJSONOptions; inline;
     function ParseNumber: TJSONNumber;
     procedure SetO(AIndex: TJSONOption; AValue: Boolean);
     procedure SetOptions(AValue: TJSONOptions);
@@ -38,7 +38,7 @@ Type
     function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
     function GetNextToken: TJSONToken;
     function CurrentTokenString: String;
-    function CurrentToken: TJSONToken;
+    function CurrentToken: TJSONToken; inline;
     function ParseArray: TJSONArray;
     function ParseObject: TJSONObject;
     Property Scanner : TJSONScanner read FScanner;

packages/fcl-json/src/jsonscanner.pp

@@ -69,13 +69,13 @@ Type
     FCurLine: string;
     TokenStr: PChar;
     FOptions : TJSONOptions;
-    function GetCurColumn: Integer;
+    function GetCurColumn: Integer; inline;
     function GetO(AIndex: TJSONOption): Boolean;
     procedure SetO(AIndex: TJSONOption; AValue: Boolean);
   protected
     procedure Error(const Msg: string);overload;
     procedure Error(const Msg: string; Const Args: array of Const);overload;
-    function DoFetchToken: TJSONToken;
+    function DoFetchToken: TJSONToken; inline;
   public
     constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
     constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';

packages/fcl-json/tests/jsonconftest.pp

@@ -179,7 +179,9 @@ begin
   C:=CreateConf('test.json');
   try
     C.SetValue('a',1);
+    C.Flush;
     C.DeleteValue('a');
+    AssertEquals('Modified set',True,C.Modified);
     AssertEquals('Delete value',0,C.GetValue('a',0));
     C.SetValue('b/a',1);
     C.SetValue('b/c',2);
@@ -187,7 +189,9 @@ begin
     AssertEquals('Delete value in subkey',0,C.GetValue('a',0));
     AssertEquals('Delete value only clears deleted value',2,C.GetValue('b/c',0));
     C.SetValue('b/a',1);
+    C.Flush;
     C.DeletePath('b');
+    AssertEquals('Modified set',True,C.Modified);
     AssertEquals('Delete path',0,C.GetValue('b/a',0));
     AssertEquals('Delete path deletes all values',0,C.GetValue('b/c',0));
     C.Clear;

packages/fcl-json/tests/testcomps.pp

@@ -191,7 +191,7 @@ Type
   Public
     Constructor Create(AOwner : TComponent);  override;
   Published
-    Property ExtendedProp : Comp Read F Write F;
+    Property CompProp : Comp Read F Write F;
   end;
 
   // Currency property

packages/fcl-json/tests/testjson.lpi

@@ -25,7 +25,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTimeFormat"/>
+        <CommandLineParams Value="--suite=TTestParser.TestObjectError"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>

packages/fcl-json/tests/testjsondata.pp

@@ -36,7 +36,7 @@ type
 
   TTestJSONString = Class(TTestCase)
   Private
-    Procedure TestTo(Const Src,Dest : String);
+    Procedure TestTo(Const Src,Dest : String; Strict : Boolean = False);
     Procedure TestFrom(Const Src,Dest : String);
   Published
     Procedure TestJSONStringToString;
@@ -147,6 +147,7 @@ type
   published
     procedure TestString;
     procedure TestControlString;
+    procedure TestSolidus;
     procedure TestInteger;
     procedure TestNegativeInteger;
     procedure TestFloat;
@@ -1501,7 +1502,6 @@ Var
   T : String;
 
 begin
-
   J:=TJSONString.Create('');
   try
     For I:=0 to 31 do
@@ -1523,6 +1523,23 @@ begin
   end;
 end;
 
+procedure TTestString.TestSolidus;
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create('');
+  try
+    J.AsString:='http://www.json.org/';
+    TJSONString.StrictEscaping:=True;
+    TestJSON(J,'"http:\/\/www.json.org\/"');
+    TJSONString.StrictEscaping:=False;
+    TestJSON(J,'"http://www.json.org/"');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 procedure TTestString.TestInteger;
 
 Const
@@ -1567,7 +1584,7 @@ begin
     TestAsBoolean(J,True,False);
     TestAsInteger(J,-1,False);
     TestAsInt64(J,-1,False);
-    TestAsQWord(J,-1,True);
+    TestAsQWord(J,QWord(-1),True);
     TestAsString(J,S);
     TestAsFloat(J,-1.0,False);
   finally
@@ -1612,7 +1629,7 @@ begin
     TestAsBoolean(J,True,False);
     TestAsInteger(J,-1,True);
     TestAsInt64(J,-1,True);
-    TestAsQWord(J,-1,True);
+    TestAsQWord(J,QWord(-1),True);
     TestAsString(J,S);
     TestAsFloat(J,-1.0,True);
   finally
@@ -4026,14 +4043,14 @@ end;
 
 { TTestJSONString }
 
-procedure TTestJSONString.TestTo(const Src, Dest: String);
+procedure TTestJSONString.TestTo(const Src, Dest: String; Strict : Boolean = False);
 
 Var
   S : String;
 
 begin
   S:='StringToJSONString('''+Src+''')='''+Dest+'''';
-  AssertEquals(S,Dest,StringToJSONString(Src));
+  AssertEquals(S,Dest,StringToJSONString(Src,Strict));
 end;
 
 procedure TTestJSONString.TestFrom(const Src, Dest: String);
@@ -4092,7 +4109,8 @@ begin
   TestTo('AB','AB');
   TestTo('ABC','ABC');
   TestTo('\','\\');
-  TestTo('/','\/');
+  TestTo('/','/');
+  TestTo('/','\/',True);
   TestTo('"','\"');
   TestTo(#8,'\b');
   TestTo(#9,'\t');
@@ -4115,7 +4133,8 @@ begin
   TestTo('A'#12'BC','A\fBC');
   TestTo('A'#13'BC','A\rBC');
   TestTo('\\','\\\\');
-  TestTo('//','\/\/');
+  TestTo('//','//');
+  TestTo('//','\/\/',true);
   TestTo('""','\"\"');
   TestTo(#8#8,'\b\b');
   TestTo(#9#9,'\t\t');

packages/fcl-json/tests/testjsonrtti.pp

@@ -5,7 +5,7 @@ unit testjsonrtti;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, typinfo, fpjson,
+  Classes, SysUtils, fpcunit, testregistry, typinfo, fpjson,
   dateutils, testcomps, testjsondata, fpjsonrtti;
 
 type
@@ -366,12 +366,8 @@ Var
 
 begin
   B:=TCompComponent.Create(Nil);
-  DeStream('{ "ExtendedProp" : 5.67 }',B);
-{$ifdef CPUX86_64}
-  AssertEquals('Correct comp value',round(5.67),B.ExtendedProp);
-{$else}
-  AssertEquals('Correct extended value',5.67,B.ExtendedProp);
-{$endif}
+  DeStream('{ "CompProp" : 5.67 }',B);
+  AssertEquals('Correct comp value',round(5.67),B.CompProp);
 end;
 
 procedure TTestJSONDeStreamer.TestFloat5;
@@ -876,12 +872,7 @@ procedure TTestJSONStreamer.TestWriteFloat4;
 begin
   StreamObject(TCompComponent.Create(Nil));
   AssertPropCount(1);
-  // Extended is correct, propname is wrong
-  {$ifdef CPUX86_64}
-    AssertProp('ExtendedProp',TJSONFloat(5));
-  {$else}
-    AssertProp('ExtendedProp',4.56);
-  {$endif}
+  AssertProp('CompProp',5);
 end;
 
 procedure TTestJSONStreamer.TestWriteFloat5;

packages/fcl-passrc/src/pasresolver.pp

@@ -91,10 +91,10 @@
   - arrays TPasArrayType
   - check if var initexpr fits vartype: var a: type = expr;
   - built-in functions high, low for range type and arrays
-
- ToDo:
   - procedure type
   - method type
+
+ ToDo:
   - char constant #0, #10, #13, UTF-8 char
   - const TArrayValues
   - classes - TPasClassType
@@ -276,6 +276,7 @@ type
     btVariant,     // variant
     btNil,         // nil = pointer, class, procedure, method, ...
     btProc,        // TPasProcedure
+    btBuiltInProc,
     btSet,
     btRange
     );
@@ -363,13 +364,15 @@ const
     'Text',
     'Variant',
     'Nil',
-    'PasProcedure',
+    'Procedure/Function',
+    'BuiltInProc',
     '[set]',
     '..range..'
     );
 
 type
   TResolverBuiltInProc = (
+    bfCustom,
     bfLength,
     bfSetLength,
     bfInclude,
@@ -385,6 +388,7 @@ type
   TResolverBuiltInProcs = set of TResolverBuiltInProc;
 const
   ResolverBuiltInProcNames: array[TResolverBuiltInProc] of shortstring = (
+    'Custom',
     'Length',
     'SetLength',
     'Include',
@@ -397,7 +401,7 @@ const
     'Low',
     'High'
     );
-  bfAllStandardProcs = [low(TResolverBuiltInProc)..high(TResolverBuiltInProc)];
+  bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
 
 const
   ResolverResultVar = 'Result';
@@ -705,8 +709,9 @@ type
   end;
 
   TResolvedReferenceFlag = (
-    rrfVMT, // use VMT for call
-    rrfNewInstance // constructor call
+    rrfCallWithoutParams, // a TPrimitiveExpr is a call without params
+    rrfNewInstance, // constructor call (without it call a constructor as normal method)
+    rrfVMT // use VMT for call
     );
   TResolvedReferenceFlags = set of TResolvedReferenceFlag;
 
@@ -766,12 +771,13 @@ type
   TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
     out ResolvedEl: TPasResolverResult) of object;
 
-  { TResElDataBuiltInProc - CustomData for compiler built-in procs like 'length' }
+  { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
 
   TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
   public
     Proc: TPasUnresolvedSymbolRef;
     Signature: string;
+    BuiltIn: TResolverBuiltInProc;
     GetCallCompatibility: TOnGetCallCompatibility;
     GetCallResult: TOnGetCallResult;
   end;
@@ -869,6 +875,7 @@ type
     procedure ResolveImplForLoop(Loop: TPasImplForLoop);
     procedure ResolveImplWithDo(El: TPasImplWithDo);
     procedure ResolveImplAssign(El: TPasImplAssign);
+    procedure ResolveImplSimple(El: TPasImplSimple);
     procedure ResolveImplRaise(El: TPasImplRaise);
     procedure ResolveExpr(El: TPasExpr);
     procedure ResolveBooleanExpr(El: TPasExpr);
@@ -982,7 +989,8 @@ type
     function IsBaseType(aType: TPasType; BaseType: TResolverBaseType): boolean;
     function AddBuiltInProc(aName: shortstring; Signature: string;
       const GetCallCompatibility: TOnGetCallCompatibility;
-      const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
+      const GetCallResult: TOnGetCallResult;
+      BuiltIn: TResolverBuiltInProc = bfCustom): TResElDataBuiltInProc;
     // add extra TResolveData (E.CustomData) to free list
     procedure AddResolveData(El: TPasElement; Data: TResolveData;
       Kind: TResolveDataListKind);
@@ -2054,7 +2062,7 @@ begin
   Item:=FindLocalIdentifier(aName);
   while Item<>nil do
     begin
-    writeln('TPasIdentifierScope.IterateElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
+    //writeln('TPasIdentifierScope.IterateElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
     {$IFDEF VerbosePasResolver}
     OldElement:=Item.Element;
     {$ENDIF}
@@ -3387,7 +3395,7 @@ begin
   else if El.ClassType=TPasImplAssign then
     ResolveImplAssign(TPasImplAssign(El))
   else if El.ClassType=TPasImplSimple then
-    ResolveExpr(TPasImplSimple(El).expr)
+    ResolveImplSimple(TPasImplSimple(El))
   else if El.ClassType=TPasImplBlock then
     ResolveImplBlock(TPasImplBlock(El))
   else if El.ClassType=TPasImplRepeatUntil then
@@ -3587,7 +3595,10 @@ begin
   ComputeElement(El.right,RightResolved,[rcSkipTypeAlias]);
 
   if RightResolved.BaseType=btProc then
+    begin
+    // ToDo: Delphi also uses left side to decide whether use function reference or function result
     ComputeProcWithoutParams(RightResolved,El.right);
+    end;
 
   case El.Kind of
   akDefault:
@@ -3638,6 +3649,14 @@ begin
   end;
 end;
 
+procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
+var
+  ExprResolved: TPasResolverResult;
+begin
+  ResolveExpr(El.expr);
+  ComputeElement(El.expr,ExprResolved,[rcSkipTypeAlias,rcReturnFuncResult]);
+end;
+
 procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
 var
   ResolvedEl: TPasResolverResult;
@@ -3713,14 +3732,15 @@ begin
   DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
   if DeclEl is TPasProcedure then
     begin
-    // identifier is a call and args brackets are missing
+    // identifier is a proc and args brackets are missing
     if El.Parent.ClassType=TPasProperty then
       // a property accessor does not need args -> ok
     else
       begin
+      // examples: funca or @proca or a.funca or @a.funca ...
       Proc:=TPasProcedure(DeclEl);
       if (Proc.ProcType.Args.Count>0)
-          and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil)
+          and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil) // no default value -> param needed
           and not ExprIsAddrTarget(El)
       then
         RaiseMsg(nWrongNumberOfParametersForCallTo,
@@ -4604,10 +4624,19 @@ procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
 var
   LeftResolved, RightResolved: TPasResolverResult;
 begin
+  if (Bin.OpCode=eopSubIdent)
+  or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
+    begin
+    ComputeElement(Bin.right,ResolvedEl,Flags);
+    exit;
+    end;
+
   ComputeElement(Bin.left,LeftResolved,Flags);
   ComputeElement(Bin.right,RightResolved,Flags);
   // ToDo: check operator overloading
 
+  //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDesc(LeftResolved),' Right=',GetResolverResultDesc(RightResolved));
+
   if LeftResolved.BaseType=btProc then
     ComputeProcWithoutParams(LeftResolved,Bin.left);
   if RightResolved.BaseType=btProc then
@@ -5181,7 +5210,7 @@ var
   Proc: TPasProcedure;
 begin
   if ExprIsAddrTarget(Expr) then exit;
-  // call without arguments
+
   if ResolvedEl.IdentEl=nil then
     RaiseNotYetImplemented(20160928183455,Expr,GetResolverResultDesc(ResolvedEl));
   if not (ResolvedEl.IdentEl is TPasProcedure) then
@@ -5191,6 +5220,9 @@ begin
       and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil) then
     RaiseMsg(nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
       [GetProcDesc(Proc.ProcType)],Expr);
+
+  if Expr.CustomData is TResolvedReference then
+    Include(TResolvedReference(Expr.CustomData).Flags,rrfCallWithoutParams);
   if (ResolvedEl.IdentEl is TPasFunction) then
     ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,[])
   else if ResolvedEl.IdentEl.ClassType=TPasConstructor then
@@ -5199,7 +5231,7 @@ begin
     SetResolverValueExpr(ResolvedEl,btContext,aClass,Expr,[rrfReadable]);
     end
   else
-    RaiseXExpectedButYFound('function',ResolvedEl.IdentEl.ElementTypeName,Expr);
+    ; // simple procedure call -> keep ResolvedEl as btProc
 end;
 
 procedure TPasResolver.CheckIsClass(El: TPasElement;
@@ -6214,37 +6246,37 @@ begin
     AddBaseType(BaseTypeNames[bt],bt);
   if bfLength in BaseProcs then
     AddBuiltInProc('Length','function Length(const String or Array): sizeint',
-        @OnGetCallCompatibility_Length,@OnGetCallResult_Length);
+        @OnGetCallCompatibility_Length,@OnGetCallResult_Length,bfLength);
   if bfSetLength in BaseProcs then
     AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
-        @OnGetCallCompatibility_SetLength,nil);
+        @OnGetCallCompatibility_SetLength,nil,bfSetLength);
   if bfInclude in BaseProcs then
     AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
-        @OnGetCallCompatibility_InExclude,nil);
+        @OnGetCallCompatibility_InExclude,nil,bfInclude);
   if bfExclude in BaseProcs then
     AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
-        @OnGetCallCompatibility_InExclude,nil);
+        @OnGetCallCompatibility_InExclude,nil,bfExclude);
   if bfOrd in BaseProcs then
     AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
-        @OnGetCallCompatibility_Ord,@OnGetCallResult_Ord);
+        @OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
   if bfExit in BaseProcs then
     AddBuiltInProc('Exit','procedure Exit(result)',
-        @OnGetCallCompatibility_Exit,nil);
+        @OnGetCallCompatibility_Exit,nil,bfExit);
   if bfInc in BaseProcs then
     AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
-        @OnGetCallCompatibility_IncDec,nil);
+        @OnGetCallCompatibility_IncDec,nil,bfInc);
   if bfDec in BaseProcs then
     AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
-        @OnGetCallCompatibility_IncDec,nil);
+        @OnGetCallCompatibility_IncDec,nil,bfDec);
   if bfAssigned in BaseProcs then
     AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
-        @OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned);
+        @OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned,bfAssigned);
   if bfLow in BaseProcs then
     AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
-        @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
+        @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfLow);
   if bfHigh in BaseProcs then
     AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
-        @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
+        @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfHigh);
 end;
 
 function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType
@@ -6272,7 +6304,8 @@ end;
 
 function TPasResolver.AddBuiltInProc(aName: shortstring; Signature: string;
   const GetCallCompatibility: TOnGetCallCompatibility;
-  const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
+  const GetCallResult: TOnGetCallResult; BuiltIn: TResolverBuiltInProc
+  ): TResElDataBuiltInProc;
 var
   El: TPasUnresolvedSymbolRef;
 begin
@@ -6280,6 +6313,7 @@ begin
   Result:=TResElDataBuiltInProc.Create;
   Result.Proc:=El;
   Result.Signature:=Signature;
+  Result.BuiltIn:=BuiltIn;
   Result.GetCallCompatibility:=GetCallCompatibility;
   Result.GetCallResult:=GetCallResult;
   AddResolveData(El,Result,lkBuiltIn);
@@ -7576,6 +7610,7 @@ begin
           begin
           if rcConstant in Flags then
             RaiseConstantExprExp(El);
+          Include(TResolvedReference(El.CustomData).Flags,rrfCallWithoutParams);
           if ResolvedEl.IdentEl is TPasFunction then
             // function => return result
             ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,Flags-[rcReturnFuncResult])
@@ -7618,7 +7653,7 @@ begin
       SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
         El,TPasUnresolvedSymbolRef(El),[])
     else if El.CustomData is TResElDataBuiltInProc then
-      RaiseInternalError(20161003174747) // should have been computed in El.ClassType=TParamsExpr
+      SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,TPasUnresolvedSymbolRef(El),[])
     else
       RaiseNotYetImplemented(20160926194756,El);
     end
@@ -7804,6 +7839,18 @@ begin
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasProcedureType(El),[])
   else if El.ClassType=TPasArrayType then
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
+  else if El.ClassType=TInheritedExpr then
+    begin
+    if El.CustomData is TResolvedReference then
+      begin
+        DeclEl:=TResolvedReference(El.CustomData).Declaration as TPasProcedure;
+        SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
+          TPasProcedure(DeclEl).ProcType,[]);
+      end
+    else
+      // no ancestor proc
+      SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[]);
+    end
   else
     RaiseNotYetImplemented(20160922163705,El);
 end;
@@ -7849,7 +7896,7 @@ begin
 end;
 
 function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
-// returns true of El is the last element of an @ operator expression
+// returns true if El is the last element of an @ operator expression
 // e.g. the OnClick in '@p().o[].OnClick'
 //  or '@s[]'
 var

packages/fcl-passrc/src/pastree.pp

@@ -622,7 +622,7 @@ type
   public
     Access: TArgumentAccess;
     ArgType: TPasType;
-    ValueExpr: TPasExpr;
+    ValueExpr: TPasExpr; // the default value
     Function Value : String;
   end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -2762,7 +2762,7 @@ begin
   Add('var {#i}i: longint;');
   Add('begin');
   Add('  {@i}i:={@P}P();');
-  CheckResolverException('function expected, but procedure found',PasResolver.nXExpectedButYFound);
+  CheckResolverException('{Incompatible types: got "Procedure/Function" expected "Longint"',PasResolver.nIncompatibleTypesGotExpected);
 end;
 
 procedure TTestResolver.TestFunctionResultInCondition;
@@ -4769,9 +4769,6 @@ begin
   Add('  ff:=@GetNumberFunc;');
   Add('  ff:=GetNumberFuncFunc; // not in Delphi');
   Add('  ff:=GetNumberFuncFunc();');
-  Add('  // forbidden: f:=GetNumberFuncFunc;');
-  Add('  // forbidden: f:=GetNumberFuncFunc();');
-  Add('  // fpc crash: f:=GetNumberFuncFunc()();');
   ParseProgram;
 end;
 

packages/fcl-web/examples/httpclient/keepalive.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="keepalive"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="keepalive.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="keepalive"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/httpclient/keepalive.pp

@@ -0,0 +1,125 @@
+program keepalive;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, fphttpclient;
+
+const
+  URL_DIRECT = 'https://www.google.com/humans.txt';
+  URL_REDIRECTED = 'https://google.com/humans.txt';
+
+type
+
+  { TKeepConnectionDemo }
+
+  TKeepConnectionDemo = class(TCustomApplication)
+  private
+    FURL : String;
+    FShowResult : Boolean;
+    FCount : Integer;
+    FHttp: TFPHTTPClient;
+    FData: TBytesStream;
+    procedure DoRequests;
+    procedure Usage(Msg: string);
+  Protected
+    Procedure DoRun; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+
+constructor TKeepConnectionDemo.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  StopOnException:=True;
+  FHttp := TFPHTTPClient.Create(nil);
+  FData := TBytesStream.Create;
+end;
+
+destructor TKeepConnectionDemo.Destroy;
+begin
+  FData.Free;
+  FHttp.Free;
+  inherited Destroy;
+end;
+
+
+procedure TKeepConnectionDemo.DoRequests;
+var
+  U: string;
+  B, E: TDateTime;
+  L : TStrings;
+  I : Integer;
+
+begin
+  for I:=1 to FCount do
+    begin
+    FData.Clear;
+    B := Now;
+    if (FURL<>'') then
+      U:=FURL
+    else if FHTTP.AllowRedirect then
+      U := URL_REDIRECTED
+    else
+      U := URL_DIRECT;
+    FHttp.Get(U, FData);
+    E := Now;
+    Writeln('Request ',i,', Duration: ',FormatDateTime('hh:nn:ss.zzz', E - B));
+    If FShowResult then
+      begin
+      FData.Seek(0, TSeekOrigin.soBeginning);
+      With TStringList.Create do
+        try
+          LoadFromStream(FData);
+          Writeln(text);
+        finally
+          Free;
+        end;
+     end;
+    end;
+end;
+
+procedure TKeepConnectionDemo.Usage(Msg : string);
+
+begin
+  if (Msg<>'') then
+    Writeln('Error : ',Msg);
+  Writeln(' Usage : keepalive [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h  --help              This help');
+  Writeln('-r  --redirect          Allow HTTP Redirect');
+  Writeln('-k  --keep-connection   Keep connection');
+  Writeln('-c  --count=N           Number of requests');
+  Writeln('-u  --URL=uri           Specify url');
+  Halt(Ord(Msg<>''));
+end;
+procedure TKeepConnectionDemo.DoRun;
+
+Var
+  S : String;
+
+begin
+  S:=CheckOptions('hrksc:u:',['count:','show','url:','redirect','keep-connection','help']);
+  if (S<>'') or HasOption('h','help') then
+    Usage(S);
+  FCount:=StrToIntDef(GetOptionValue('c','count'),10);
+  FShowResult:=HasOption('s','show');
+  FURL:=GetOptionValue('u','url');
+  FHTTP.AllowRedirect:=HasOption('r','redirect');
+  FHTTP.KeepConnection:=HasOption('k','keep-connection');
+  DoRequests;
+  Terminate;
+end;
+
+begin
+  With TKeepConnectionDemo.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    Finally
+      Free;
+    end;
+end.
+

packages/fcl-web/src/base/fphttpclient.pp

@@ -70,6 +70,7 @@ Type
     FDataRead : Int64;
     FContentLength : Int64;
     FAllowRedirect: Boolean;
+    FKeepConnection: Boolean;
     FMaxRedirects: Byte;
     FOnDataReceived: TDataEvent;
     FOnHeaders: TNotifyEvent;
@@ -97,11 +98,26 @@ Type
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetHTTPVersion(const AValue: String);
+    procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
+    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
+    Procedure CheckConnectionCloseHeader;
   protected
+
     Function NoContentAllowed(ACode : Integer) : Boolean;
+    // Peform a request, close connection.
+    Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Peform a request, try to keep connection.
+    Procedure DoKeepConnectionRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Return True if FSocket is assigned
+    Function IsConnected: Boolean; virtual;
     // True if we need to use a proxy: ProxyData Assigned and Hostname Set
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
@@ -113,19 +129,23 @@ Type
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     // Read 1 line of response. Fills FBuffer
-    function ReadString: String;
+    function ReadString(out S: String): Boolean;
     // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
     // If AllowRedirect is true, and the result is a Redirect status code, the result is also true
     // If the OnPassword event is set, then a 401 will also result in True.
     function CheckResponseCode(ACode: Integer;  const AllowedResponseCodes: array of Integer): Boolean; virtual;
     // Read response from server, and write any document to Stream.
-    Procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
+    Function ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
     // Read server response line and headers. Returns status code.
     Function ReadResponseHeaders : integer; virtual;
     // Allow header in request ? (currently checks only if non-empty and contains : token)
     function AllowHeader(var AHeader: String): Boolean; virtual;
+    // Return True if the "connection: close" header is present
+    Function HasConnectionClose: Boolean; virtual;
     // Connect to the server. Must initialize FSocket.
     Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
+    // Re-connect to the server. Must reinitialize FSocket.
+    Procedure ReconnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
     // Disconnect from server. Must free FSocket.
     Procedure DisconnectFromServer; virtual;
     // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
@@ -152,7 +172,7 @@ Type
     // Add header, replacing an existing one if it exists.
     Procedure AddHeader(Const AHeader,AValue : String);
     // Return header value, empty if not present.
-    Function GetHeader(Const AHeader : String) : String;
+    Function  GetHeader(Const AHeader : String) : String;
     // General-purpose call. Handles redirect and authorization retry (OnPassword).
     Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
     // Execute GET on server, store result in Stream, File, StringList or string
@@ -254,7 +274,8 @@ Type
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
-    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+    // Setting this to any other value than 1.1 will set KeepConnection to False.
+    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
     // After request properties.
     // After request, this contains the headers sent by server.
     Property ResponseHeaders : TStrings Read FResponseHeaders;
@@ -278,6 +299,10 @@ Type
     // They also override any Authenticate: header in Requestheaders.
     Property UserName : String Read FUserName Write FUserName;
     Property Password : String Read FPassword Write FPassword;
+    // Is client connected?
+    Property Connected: Boolean read IsConnected;
+    // Keep-Alive support. Setting to true will set HTTPVersion to 1.1
+    Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
     // If a request returns a 401, then the OnPassword event is fired.
     // It can modify the username/password and set RepeatRequest to true;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
@@ -293,6 +318,8 @@ Type
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   Published
+    Property KeepConnection;
+    Property Connected;
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -458,6 +485,11 @@ begin
     FSocket.IOTimeout:=AValue;
 end;
 
+function TFPCustomHTTPClient.IsConnected: Boolean;
+begin
+  Result := Assigned(FSocket);
+end;
+
 function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
 begin
   Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
@@ -544,6 +576,8 @@ Var
 
 
 begin
+  If IsConnected Then
+    DisconnectFromServer; // avoid memory leaks
   if (Aport=0) then
     if UseSSL then
       Aport:=443
@@ -561,6 +595,13 @@ begin
   end;
 end;
 
+Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
+  APort: Integer; UseSSL: Boolean);
+begin
+  DisconnectFromServer;
+  ConnectToServer(AHost, APort, UseSSL);
+end;
+
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
 begin
@@ -573,6 +614,11 @@ begin
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
 end;
 
+Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
+begin
+  Result := CompareText(GetHeader('Connection'), 'close') = 0;
+end;
+
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 Var
@@ -607,6 +653,7 @@ begin
   S:=S+CRLF;
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
+  CheckConnectionCloseHeader;
   For I:=0 to FRequestHeaders.Count-1 do
     begin
     l:=FRequestHeaders[i];
@@ -634,9 +681,9 @@ begin
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 
-function TFPCustomHTTPClient.ReadString : String;
+function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
 
-  Procedure FillBuffer;
+  Function FillBuffer: Boolean;
 
   Var
     R : Integer;
@@ -644,38 +691,42 @@ function TFPCustomHTTPClient.ReadString : String;
   begin
     SetLength(FBuffer,ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    If r=0 Then
+      Exit(False);
     If r<0 then
       Raise EHTTPClient.Create(SErrReadingSocket);
     if (r<ReadBuflen) then
       SetLength(FBuffer,r);
     FDataRead:=FDataRead+R;
     DoDataRead;
+    Result:=r>0;
   end;
 
 Var
-  CheckLF,Done : Boolean;
+  CheckLF: Boolean;
   P,L : integer;
 
 begin
-  Result:='';
-  Done:=False;
+  S:='';
+  Result:=False;
   CheckLF:=False;
   Repeat
     if Length(FBuffer)=0 then
-      FillBuffer;
+      if not FillBuffer then
+        Break;
     if Length(FBuffer)=0 then
-      Done:=True
+      Result:=True
     else if CheckLF then
       begin
       If (FBuffer[1]<>#10) then
-        Result:=Result+#13
+        S:=S+#13
       else
         begin
         System.Delete(FBuffer,1,1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-    if not Done then
+    if not Result then
       begin
       P:=Pos(#13#10,FBuffer);
       If P=0 then
@@ -683,20 +734,21 @@ begin
         L:=Length(FBuffer);
         CheckLF:=FBuffer[L]=#13;
         if CheckLF then
-          Result:=Result+Copy(FBuffer,1,L-1)
+          S:=S+Copy(FBuffer,1,L-1)
         else
-          Result:=Result+FBuffer;
+          S:=S+FBuffer;
         FBuffer:='';
         end
       else
         begin
-        Result:=Result+Copy(FBuffer,1,P-1);
+        S:=S+Copy(FBuffer,1,P-1);
         System.Delete(FBuffer,1,P+1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-  until Done;
+  until Result;
 end;
+
 Function GetNextWord(Var S : String) : string;
 
 Const
@@ -765,11 +817,11 @@ Var
   StatusLine,S : String;
 
 begin
-  StatusLine:=ReadString;
+  if not ReadString(StatusLine) then
+    Exit(0);
   Result:=ParseStatusLine(StatusLine);
   Repeat
-    S:=ReadString;
-    if (S<>'') then
+    if ReadString(S) and (S<>'') then
       begin
       ResponseHeaders.Add(S);
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
@@ -877,14 +929,33 @@ begin
   GetCookies.Assign(AValue);
 end;
 
+procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
+begin
+  if FHTTPVersion = AValue then Exit;
+  FHTTPVersion := AValue;
+  if (AValue<>'1.1') then
+    KeepConnection:=False;
+end;
+
+procedure TFPCustomHTTPClient.SetKeepConnection(AValue: Boolean);
+begin
+  if FKeepConnection=AValue then Exit;
+  FKeepConnection:=AValue;
+  if AValue then
+    HTTPVersion:='1.1'
+  else if IsConnected then
+    DisconnectFromServer;
+  CheckConnectionCloseHeader;
+end;
+
 procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
 begin
   if (AValue=FProxy) then exit;
   Proxy.Assign(AValue);
 end;
 
-procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
-  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
+Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
+  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -1012,6 +1083,9 @@ begin
   FContentLength:=0;
   SetLength(FBuffer,0);
   FResponseStatusCode:=ReadResponseHeaders;
+  Result := FResponseStatusCode > 0;
+  if not Result then
+    Exit;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
@@ -1050,13 +1124,99 @@ begin
     end;
 end;
 
-procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
-  Stream: TStream; const AllowedResponseCodes: array of Integer);
+Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
+  Out APort: Word);
+Begin
+  if ProxyActive then
+    begin
+    AHost:=Proxy.Host;
+    APort:=Proxy.Port;
+    end
+  else
+    begin
+    AHost:=AURI.Host;
+    APort:=AURI.Port;
+    end;
+End;
+
+procedure TFPCustomHTTPClient.CheckConnectionCloseHeader;
 
 Var
-  URI : TURI;
-  P,CHost : String;
-  CPort : Word;
+  I : integer;
+  N,V : String;
+
+begin
+  V:=GetHeader('Connection');
+  If FKeepConnection Then
+    begin
+    I:=IndexOfHeader(FRequestHeaders,'Connection');
+    If i>-1 Then
+      begin
+      // It can be keep-alive, check value
+      FRequestHeaders.GetNameValue(I,N,V);
+      If CompareText(V,'close')=0  then
+        FRequestHeaders.Delete(i);
+      end
+    end
+  Else
+    AddHeader('Connection', 'close');
+end;
+
+Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  ConnectToServer(CHost,CPort,AIsHttps);
+  Try
+    SendRequest(AMethod,AURI);
+    ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+  Finally
+    DisconnectFromServer;
+  End;
+end;
+
+Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  T: Boolean;
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  T := False;
+  Repeat
+    If Not IsConnected Then
+      ConnectToServer(CHost,CPort,AIsHttps);
+    Try
+      SendRequest(AMethod,AURI);
+      T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+      If Not T Then
+        ReconnectToServer(CHost,CPort,AIsHttps);
+    Finally
+      If HasConnectionClose Then
+        DisconnectFromServer;
+    End;
+  Until T;
+end;
+
+Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
+  Stream: TStream; Const AllowedResponseCodes: Array of Integer);
+
+Var
+  URI: TURI;
+  P: String;
+  IsHttps, HeadersOnly: Boolean;
 
 begin
   ResetResponse;
@@ -1064,23 +1224,12 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  if ProxyActive then
-    begin
-    CHost:=Proxy.Host;
-    CPort:=Proxy.Port;
-    end
+  IsHttps:=P='https';
+  HeadersOnly:=CompareText(AMethod,'HEAD')=0;
+  if FKeepConnection then
+    DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
   else
-    begin
-    CHost:=URI.Host;
-    CPort:=URI.Port;
-    end;
-  ConnectToServer(CHost,CPort,P='https');
-  try
-    SendRequest(AMethod,URI);
-    ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
-  finally
-    DisconnectFromServer;
-  end;
+    DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
 end;
 
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
@@ -1089,13 +1238,17 @@ begin
   // Infinite timeout on most platforms
   FIOTimeout:=0;
   FRequestHeaders:=TStringList.Create;
+  FRequestHeaders.NameValueSeparator:=':';
   FResponseHeaders:=TStringList.Create;
-  FHTTPVersion:='1.1';
+  FResponseHeaders.NameValueSeparator:=':';
+  HTTPVersion:='1.1';
   FMaxRedirects:=DefMaxRedirects;
 end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  if IsConnected then
+    DisconnectFromServer;
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
@@ -1205,7 +1358,7 @@ begin
         FOnPassword(Self,RR);
       end
     else
-      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
+      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
   until not RR;
 end;
 
@@ -1273,7 +1426,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Stream);
     finally
       Free;
@@ -1287,7 +1440,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,LocalFileName);
     finally
       Free;
@@ -1301,7 +1454,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Response);
     finally
       Free;
@@ -1369,7 +1522,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
     finally
       Free;
@@ -1383,7 +1536,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
     finally
       Free;
@@ -1397,7 +1550,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,LocalFileName);
     finally
       Free;
@@ -1410,7 +1563,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Post(URL);
     finally
       Free;
@@ -1461,7 +1614,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
     finally
       Free;
@@ -1474,7 +1627,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
     finally
       Free;
@@ -1487,7 +1640,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,LocalFileName);
     finally
       Free;
@@ -1499,7 +1652,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Put(URL);
     finally
       Free;
@@ -1551,7 +1704,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1564,7 +1717,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1577,7 +1730,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,LocalFileName);
     finally
       Free;
@@ -1589,7 +1742,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Delete(URL);
     finally
       Free;
@@ -1641,7 +1794,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
     finally
       Free;
@@ -1654,7 +1807,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
     finally
       Free;
@@ -1667,7 +1820,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,LocalFileName);
     finally
       Free;
@@ -1679,7 +1832,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Options(URL);
     finally
       Free;
@@ -1690,7 +1843,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       HTTPMethod('HEAD', AURL, Nil, [200]);
       Headers.Assign(ResponseHeaders);
     Finally
@@ -1775,7 +1928,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1789,7 +1942,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1803,7 +1956,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1816,7 +1969,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1829,7 +1982,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1842,7 +1995,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1921,7 +2074,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
       Free;

packages/fcl-web/src/base/iniwebsession.pp

@@ -340,7 +340,7 @@ end;
 
 destructor TIniWebSession.Destroy;
 begin
-  // In case an exception occured and UpdateResponse is not called,
+  // In case an exception occurred and UpdateResponse is not called,
   // write the updates to disk and free FIniFile
   FreeIniFile;
   inherited Destroy;
@@ -376,7 +376,7 @@ begin
   SID := '';
   FSessionStarted := False;
   FTerminated := False;
-  // If a exception occured during a prior request FIniFile is still not freed
+  // If a exception occurred during a prior request FIniFile is still not freed
   if assigned(FIniFile) then FreeIniFile;
   If (SessionCookie='') then
     SessionCookie:=SFPWebSession;

packages/fpgtk/src/fpgtkext.pp

@@ -214,7 +214,7 @@ implementation
 
 resourcestring
   rsNothingToRun = 'No main window defined, nothing to do...';
-  rsErrorTitle = 'Error occured';
+  rsErrorTitle = 'Error occurred';
   rsMessageTitle = 'Message';
   sErrWrongItemType = 'Items in list are not from TFPgtkMenuItem class.';
 

packages/fpmkunit/src/fpmkunit.pp

@@ -7420,7 +7420,7 @@ Var
             // The thread has completed compiling the package
             if AThread.CompilationOK then
               AThread.APackage.FTargetState:=tsCompiled
-            else // A problem occured, stop the compilation
+            else // A problem occurred, stop the compilation
               begin
               ErrorState:=true;
               ErrorMessage:=AThread.ErrorMessage;

packages/pastojs/tests/tcconverter.pp

@@ -611,7 +611,7 @@ begin
   AssertNull('No second statement',L.B);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),El.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   AssertNull('No second statement',L.B);
 end;
 
@@ -648,7 +648,7 @@ begin
   O.Body:=CreateAssignStatement('b','c');
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
@@ -696,7 +696,7 @@ begin
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
@@ -782,7 +782,7 @@ begin
   S:=TPrimitiveExpr.Create(Nil,pekString,'''me''');
   E:=TestLiteralExpression(S,TJSLiteral);
   AssertEquals('Correct literal type',jstString,E.Value.ValueType);
-  AssertEquals('Correct literal value','me',E.Value.AsString);
+  AssertEquals('Correct literal value','me',String(E.Value.AsString));
 end;
 
 Procedure TTestExpressionConverter.TestPrimitiveNumber;
@@ -843,7 +843,7 @@ Var
 begin
   Id:=TPrimitiveExpr.Create(Nil,pekIdent,'a');
   Res:=TJSPrimaryExpressionIdent(Convert(Id,TJSPrimaryExpressionIdent));
-  AssertEquals('Correct identifier name','a',Res.Name);
+  AssertEquals('Correct identifier name','a',String(Res.Name));
 end;
 
 Procedure TTestExpressionConverter.TestUnaryMinus;
@@ -1203,7 +1203,7 @@ begin
   Uni:=TJSUnary(AssertElement('Sl.A is TJSUnary',TJSUnary,Sl.A));
   Asi:=TJSSimpleAssignStatement(AssertElement('Sl.A is TJSUnary',TJSSimpleAssignStatement,Uni.A));
   pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
-  AssertEquals('Correct name','myclass',pex.Name);
+  AssertEquals('Correct name','myclass',String(pex.Name));
   Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
   if Call=nil then ;
 end;
@@ -1264,7 +1264,7 @@ end;
 Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSString);
 begin
   AssertLiteral(Msg,Lit,jstString);
-  AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsString);
+  AssertEquals(Msg+': Correct value',String(AValue),String(TJSLiteral(Lit).Value.AsString));
 end;
 
 Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSNumber);
@@ -1278,12 +1278,12 @@ Class procedure TTestConverter.AssertIdentifier(Const Msg: String;
 begin
   AssertNotNull(Msg+': Have instance',Ident);
   AssertEquals(Msg+': Correct class',TJSPrimaryExpressionIdent,Ident.ClassType);
-  AssertEquals(Msg+': Correct name',AName,TJSPrimaryExpressionIdent(Ident).Name);
+  AssertEquals(Msg+': Correct name',AName,String(TJSPrimaryExpressionIdent(Ident).Name));
 end;
 
 Class Function TTestConverter.CreateLiteral(AValue: String): TPasExpr;
 begin
-  Result:=TPrimitiveExpr.Create(Nil,pekString,'me');
+  Result:=TPrimitiveExpr.Create(Nil,pekString,AValue);
 end;
 
 Class Function TTestConverter.CreateLiteral(AValue: Double): TPasExpr;
@@ -1293,7 +1293,7 @@ Var
 
 begin
   Str(AValue,S);
-  Result:=TPrimitiveExpr.Create(Nil,pekNumber,S);
+  Result:=TPrimitiveExpr.Create(Nil,pekNumber,Trim(S));
 end;
 
 Class Function TTestConverter.CreateIdent(AName: String): TPrimitiveExpr;

packages/pastojs/tests/tcmodules.pas

@@ -14,7 +14,8 @@
  **********************************************************************
 
  Examples:
-    ./testpas2js --suite=TTestModuleConverter.TestEmptyProgram
+    ./testpas2js --suite=TTestModule.TestEmptyProgram
+    ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
 unit tcmodules;
 
@@ -92,8 +93,9 @@ type
     procedure TearDown; override;
     Procedure Add(Line: string);
     Procedure StartParsing;
-    Procedure ParseModule;
+    procedure ParseModule;
     procedure ParseProgram;
+    procedure ParseUnit;
   protected
     function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
     function AddModule(aFilename: string): TTestEnginePasResolver;
@@ -102,7 +104,10 @@ type
       ImplementationSrc: string): TTestEnginePasResolver;
     procedure AddSystemUnit;
     procedure StartProgram(NeedSystemUnit: boolean);
+    procedure StartUnit(NeedSystemUnit: boolean);
+    Procedure ConvertModule;
     Procedure ConvertProgram;
+    Procedure ConvertUnit;
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
     function GetDottedIdentifier(El: TJSElement): string;
     procedure CheckSource(Msg,Statements, InitStatements: string);
@@ -128,10 +133,47 @@ type
     property Scanner: TPascalScanner read FScanner;
     property Parser: TTestPasParser read FParser;
   Published
+    // modules
     Procedure TestEmptyProgram;
+    Procedure TestEmptyUnit;
+
+    // vars/const
     Procedure TestVarInt;
+    Procedure TestVarBaseTypes;
+    Procedure TestConstBaseTypes;
+    Procedure TestUnitImplVars;
+    Procedure TestUnitImplConsts;
+    Procedure TestUnitImplRecord;
+
     Procedure TestEmptyProc;
+    Procedure TestAliasTypeRef;
+
+    // functions
+    Procedure TestProcOneParam;
+    Procedure TestFunctionWithoutParams;
+    Procedure TestProcedureWithoutParams;
+    Procedure TestPrgProcVar;
     Procedure TestProcTwoArgs;
+    Procedure TestUnitProcVar;
+    Procedure TestFunctionResult;
+    // ToDo: overloads
+    Procedure TestNestedProc;
+    Procedure TestForwardProc;
+    Procedure TestNestedForwardProc;
+    Procedure TestAssignFunctionResult;
+    Procedure TestFunctionResultInCondition;
+    Procedure TestExit;
+
+    // ToDo: pass by reference
+
+    // ToDo: procedure type
+
+    // ToDo: enums
+
+    // statements
+    Procedure TestIncDec;
+    Procedure TestAssignments;
+    Procedure TestOperators1;
     Procedure TestFunctionInt;
     Procedure TestFunctionString;
     Procedure TestVarRecord;
@@ -140,6 +182,27 @@ type
     Procedure TestRepeatUntil;
     Procedure TestAsmBlock;
     Procedure TestTryFinally;
+    // ToDo: try..except
+    Procedure TestCaseOf;
+    Procedure TestCaseOf_UseSwitch;
+    Procedure TestCaseOfNoElse;
+    Procedure TestCaseOfNoElse_UseSwitch;
+    Procedure TestCaseOfRange;
+
+    // classes
+    // ToDo: var
+    // ToDo: inheritance
+    // ToDo: constructor
+    // ToDo: second constructor
+    // ToDo: call another constructor within a constructor
+    // ToDo: newinstance
+    // ToDo: BeforeDestruction
+    // ToDo: AfterConstruction
+    // ToDo: event
+
+    // ToDo: class of
+
+    // ToDo: arrays
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -365,22 +428,15 @@ begin
 end;
 
 procedure TTestModule.ParseModule;
-begin
-  StartParsing;
-  Parser.ParseMain(FModule);
-  AssertNotNull('Module resulted in Module',FModule);
-  AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
-end;
-
-procedure TTestModule.ParseProgram;
 begin
   FFirstPasStatement:=nil;
   try
-    ParseModule;
+    StartParsing;
+    Parser.ParseMain(FModule);
   except
     on E: EParserError do
       begin
-      writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message
+      writeln('ERROR: TTestModule.ParseModule Parser: '+E.ClassName+':'+E.Message
         +' File='+Scanner.CurFilename
         +' LineNo='+IntToStr(Scanner.CurRow)
         +' Col='+IntToStr(Scanner.CurColumn)
@@ -390,7 +446,7 @@ begin
       end;
     on E: EPasResolve do
       begin
-      writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
+      writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message
         +' File='+Scanner.CurFilename
         +' LineNo='+IntToStr(Scanner.CurRow)
         +' Col='+IntToStr(Scanner.CurColumn)
@@ -400,11 +456,18 @@ begin
       end;
     on E: Exception do
       begin
-      writeln('ERROR: TTestModule.ParseProgram Exception: '+E.ClassName+':'+E.Message);
+      writeln('ERROR: TTestModule.ParseModule Exception: '+E.ClassName+':'+E.Message);
       raise E;
       end;
   end;
+  AssertNotNull('Module resulted in Module',FModule);
+  AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
   TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
+end;
+
+procedure TTestModule.ParseProgram;
+begin
+  ParseModule;
   AssertEquals('Has program',TPasProgram,Module.ClassType);
   FPasProgram:=TPasProgram(Module);
   AssertNotNull('Has program section',PasProgram.ProgramSection);
@@ -414,6 +477,18 @@ begin
       FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
 end;
 
+procedure TTestModule.ParseUnit;
+begin
+  ParseModule;
+  AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
+  AssertNotNull('Has interface section',Module.InterfaceSection);
+  AssertNotNull('Has implementation section',Module.ImplementationSection);
+  if (Module.InitializationSection<>nil)
+      and (Module.InitializationSection.Elements.Count>0)
+      and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
+    FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
+end;
+
 function TTestModule.FindModuleWithFilename(aFilename: string
   ): TTestEnginePasResolver;
 var
@@ -488,20 +563,29 @@ begin
   Add('');
 end;
 
-procedure TTestModule.ConvertProgram;
+procedure TTestModule.StartUnit(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('unit Test1;');
+  Add('');
+end;
+
+procedure TTestModule.ConvertModule;
 var
   ModuleNameExpr: TJSLiteral;
   FunDecl, InitFunction: TJSFunctionDeclarationStatement;
   FunDef: TJSFuncDef;
   InitAssign: TJSSimpleAssignStatement;
   FunBody: TJSFunctionBody;
+  InitName: String;
 begin
-  FJSSource:=TStringList.Create;
-  Add('end.');
-  ParseProgram;
   FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
+  FJSSource:=TStringList.Create;
   FJSSource.Text:=JSToStr(JSModule);
-  writeln('TTestModule.ConvertProgram JS:');
+  writeln('TTestModule.ConvertModule JS:');
   write(FJSSource.Text);
 
   // rtl.module(...
@@ -519,7 +603,10 @@ begin
   AssertNotNull('module name param',JSModuleCallArgs.Elements.Elements[0].Expr);
   ModuleNameExpr:=JSModuleCallArgs.Elements.Elements[0].Expr as TJSLiteral;
   AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
-  AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString));
+  if Module is TPasProgram then
+    AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
+  else
+    AssertEquals('module name',lowercase(Module.Name),String(ModuleNameExpr.Value.AsString));
 
   // main uses section
   AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr);
@@ -538,12 +625,39 @@ begin
   FJSModuleSrc:=FunBody.A as TJSSourceElements;
 
   // init this.$main - the last statement
-  AssertEquals('this.$main function 1',true,JSModuleSrc.Statements.Count>0);
-  InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
-  CheckDottedIdentifier('init function',InitAssign.LHS,'this.$main');
+  if Module is TPasProgram then
+    begin
+    InitName:='$main';
+    AssertEquals('this.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
+    end
+  else
+    InitName:='$init';
+  FJSInitBody:=nil;
+  if JSModuleSrc.Statements.Count>0 then
+    begin
+    InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
+    if GetDottedIdentifier(InitAssign.LHS)='this.'+InitName then
+      begin
+      InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
+      FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
+      end
+    else if Module is TPasProgram then
+      CheckDottedIdentifier('init function',InitAssign.LHS,'this.'+InitName);
+    end;
+end;
+
+procedure TTestModule.ConvertProgram;
+begin
+  Add('end.');
+  ParseProgram;
+  ConvertModule;
+end;
 
-  InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
-  FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
+procedure TTestModule.ConvertUnit;
+begin
+  Add('end.');
+  ParseUnit;
+  ConvertModule;
 end;
 
 procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
@@ -556,7 +670,7 @@ begin
   else
     begin
     AssertNotNull(Msg,El);
-    AssertEquals(Msg,DottedName,GetDottedIdentifier(EL));
+    AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
     end;
 end;
 
@@ -574,13 +688,20 @@ end;
 
 procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
 var
-  ActualSrc, ExpectedSrc: String;
+  ActualSrc, ExpectedSrc, InitName: String;
 begin
   ActualSrc:=JSToStr(JSModuleSrc);
-  ExpectedSrc:=Statements+LineEnding
-    +'this.$main = function () {'+LineEnding
-    +InitStatements
-    +'};'+LineEnding;
+  ExpectedSrc:=Statements;
+  if Module is TPasProgram then
+    InitName:='$main'
+  else
+    InitName:='$init';
+  if (Module is TPasProgram) or (InitStatements<>'') then
+    ExpectedSrc:=ExpectedSrc+LineEnding
+      +'this.'+InitName+' = function () {'+LineEnding
+      +InitStatements
+      +'};'+LineEnding;
+  //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
   CheckDiff(Msg,ExpectedSrc,ActualSrc);
 end;
 
@@ -696,6 +817,14 @@ begin
   CheckSource('Empty program','','');
 end;
 
+procedure TTestModule.TestEmptyUnit;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  ConvertUnit;
+end;
+
 procedure TTestModule.TestVarInt;
 begin
   StartProgram(false);
@@ -705,6 +834,70 @@ begin
   CheckSource('TestVarInt','this.i=0;','');
 end;
 
+procedure TTestModule.TestVarBaseTypes;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  i2: longint = 3;');
+  Add('  s2: string = ''foo'';');
+  Add('  c2: char = ''4'';');
+  Add('  b2: boolean = true;');
+  Add('  d2: double = 5.6;');
+  Add('  i3: longint = $707;');
+  Add('  i4: int64 = 4503599627370495;');
+  Add('  i5: int64 = -4503599627370496;');
+  Add('  i6: int64 =   $fffffffffffff;');
+  Add('  i7: int64 = -$10000000000000;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarBaseTypes',
+    LinesToStr([
+    'this.i=0;',
+    'this.s="";',
+    'this.c="";',
+    'this.b=false;',
+    'this.d=0;',
+    'this.i2=3;',
+    'this.s2="foo";',
+    'this.c2="4";',
+    'this.b2=true;',
+    'this.d2=5.6;',
+    'this.i3=0x707;',
+    'this.i4= 4503599627370495;',
+    'this.i5= -4503599627370496;',
+    'this.i6= 0xfffffffffffff;',
+    'this.i7=-0x10000000000000;'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestConstBaseTypes;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  i: longint = 3;');
+  Add('  s: string = ''foo'';');
+  Add('  c: char = ''4'';');
+  Add('  b: boolean = true;');
+  Add('  d: double = 5.6;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarBaseTypes',
+    LinesToStr([
+    'this.i=3;',
+    'this.s="foo";',
+    'this.c="4";',
+    'this.b=true;',
+    'this.d=5.6;'
+    ]),
+    '');
+end;
+
 procedure TTestModule.TestEmptyProc;
 begin
   StartProgram(false);
@@ -723,6 +916,530 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestAliasTypeRef;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  a=longint;');
+  Add('  b=a;');
+  Add('var');
+  Add('  c: a;');
+  Add('  d: b;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestAliasTypeRef',
+    LinesToStr([ // statements
+    'this.c = 0;',
+    'this.d = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProcOneParam;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  ProcA(3);');
+  ConvertProgram;
+  CheckSource('TestProcOneParam',
+    LinesToStr([ // statements
+    'this.proca = function (i) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    'this.proca(3);'
+    ]));
+end;
+
+procedure TTestModule.TestFunctionWithoutParams;
+begin
+  StartProgram(false);
+  Add('function FuncA: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  i:=FuncA();');
+  Add('  i:=FuncA;');
+  Add('  FuncA();');
+  Add('  FuncA;');
+  ConvertProgram;
+  CheckSource('TestProcWithoutParams',
+    LinesToStr([ // statements
+    'this.funca = function () {',
+    '  var result = 0;',
+    '  return result;',
+    '};',
+    'this.i=0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.i=this.funca();',
+    'this.i=this.funca();',
+    'this.funca();',
+    'this.funca();'
+    ]));
+end;
+
+procedure TTestModule.TestProcedureWithoutParams;
+begin
+  StartProgram(false);
+  Add('procedure ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  ProcA();');
+  Add('  ProcA;');
+  ConvertProgram;
+  CheckSource('TestProcWithoutParams',
+    LinesToStr([ // statements
+    'this.proca = function () {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    'this.proca();',
+    'this.proca();'
+    ]));
+end;
+
+procedure TTestModule.TestIncDec;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  inc(i);');
+  Add('  inc(i,2);');
+  Add('  dec(i);');
+  Add('  dec(i,3);');
+  ConvertProgram;
+  CheckSource('TestIncDec',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.i+=1;',
+    'this.i+=2;',
+    'this.i-=1;',
+    'this.i-=3;'
+    ]));
+end;
+
+procedure TTestModule.TestAssignments;
+begin
+  StartProgram(false);
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Add('var');
+  Add('  i:longint;');
+  Add('begin');
+  Add('  i:=3;');
+  Add('  i+=4;');
+  Add('  i-=5;');
+  Add('  i*=6;');
+  ConvertProgram;
+  CheckSource('TestAssignments',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.i=3;',
+    'this.i+=4;',
+    'this.i-=5;',
+    'this.i*=6;'
+    ]));
+end;
+
+procedure TTestModule.TestOperators1;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1,v2,v3:longint;');
+  Add('begin');
+  Add('  v1:=1;');
+  Add('  v2:=v1+v1;');
+  Add('  v2:=v1+v1*v2+v1 div v2;');
+  Add('  v3:=-v1;');
+  Add('  v1:=v1-v2;');
+  Add('  v2:=v1;');
+  Add('  if v1<v2 then v3:=v1 else v3:=v2;');
+  ConvertProgram;
+  CheckSource('TestOperators1',
+    LinesToStr([ // statements
+    'this.v1 = 0;',
+    'this.v2 = 0;',
+    'this.v3 = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.v1 = 1;',
+    'this.v2 = (this.v1 + this.v1);',
+    'this.v2 = ((this.v1 + (this.v1 * this.v2)) + (this.v1 / this.v2));',
+    'this.v3 = -this.v1;',
+    'this.v1 = (this.v1 - this.v2);',
+    'this.v2 = this.v1;',
+    'if ((this.v1 < this.v2)) this.v3 = this.v1 else this.v3 = this.v2;'
+    ]));
+end;
+
+procedure TTestModule.TestPrgProcVar;
+begin
+  StartProgram(false);
+  Add('procedure Proc1;');
+  Add('type');
+  Add('  t1=longint;');
+  Add('var');
+  Add('  v1:t1;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestPrgProcVar',
+    LinesToStr([ // statements
+    'this.proc1 = function () {',
+    '  var v1=0;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestUnitProcVar;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('');
+  Add('type t1=string; // unit scope');
+  Add('procedure Proc1;');
+  Add('');
+  Add('implementation');
+  Add('');
+  Add('procedure Proc1;');
+  Add('type t1=longint; // local proc scope');
+  Add('var  v1:t1; // using local t1');
+  Add('begin');
+  Add('end;');
+  Add('var  v2:t1; // using interface t1');
+  ConvertUnit;
+  CheckSource('TestUnitProcVar',
+    LinesToStr([ // statements
+    'var $impl = {',
+    '};',
+    'this.proc1 = function () {',
+    '  var v1 = 0;',
+    '};',
+    'this.$impl = $impl;',
+    '$impl.v2 = "";'
+    ]),
+    '' // this.$init
+    );
+end;
+
+procedure TTestModule.TestFunctionResult;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestFunctionResult',
+    LinesToStr([ // statements
+    'this.func1 = function () {',
+    '  var result = 0;',
+    '  result = 3;',
+    '  return result;',
+    '};'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestNestedProc;
+begin
+  StartProgram(false);
+  Add('function DoIt(a,d: longint): longint;');
+  Add('var');
+  Add('  b: longint;');
+  Add('  c: longint;');
+  Add('  function Nesty(a: longint): longint; ');
+  Add('  var b: longint;');
+  Add('  begin');
+  Add('    Result:=a+b+c+d;');
+  Add('  end;');
+  Add('begin');
+  Add('  Result:=a+b+c;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestNestedProc',
+    LinesToStr([ // statements
+    'this.doit = function (a, d) {',
+    '  var result = 0;',
+    '  var b = 0;',
+    '  var c = 0;',
+    '  function nesty(a) {',
+    '    var result = 0;',
+    '    var b = 0;',
+    '    result = (((a + b) + c) + d);',
+    '    return result;',
+    '  };',
+    '  result = ((a + b) + c);',
+    '  return result;',
+    '};'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure FuncA(i: longint); forward;');
+  Add('procedure FuncB(i: longint);');
+  Add('begin');
+  Add('  FuncA(i);');
+  Add('end;');
+  Add('procedure FuncA(i: longint);');
+  Add('begin');
+  Add('  if i=3 then ;');
+  Add('end;');
+  Add('begin');
+  Add('  FuncA(4);');
+  Add('  FuncB(5);');
+  ConvertProgram;
+  CheckSource('TestForwardProc',
+    LinesToStr([ // statements'
+    'this.funcb = function (i) {',
+    '  this.funca(i);',
+    '};',
+    'this.funca = function (i) {',
+    '  if ((i == 3)) {',
+    '  };',
+    '};'
+    ]),
+    LinesToStr([
+    'this.funca(4);',
+    'this.funcb(5);'
+    ])
+    );
+end;
+
+procedure TTestModule.TestNestedForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure FuncA;');
+  Add('  procedure FuncB(i: longint); forward;');
+  Add('  procedure FuncC(i: longint);');
+  Add('  begin');
+  Add('    FuncB(i);');
+  Add('  end;');
+  Add('  procedure FuncB(i: longint);');
+  Add('  begin');
+  Add('    if i=3 then ;');
+  Add('  end;');
+  Add('begin');
+  Add('  FuncC(4)');
+  Add('end;');
+  Add('begin');
+  Add('  FuncA;');
+  ConvertProgram;
+  CheckSource('TestNestedForwardProc',
+    LinesToStr([ // statements'
+    'this.funca = function () {',
+    '  function funcc(i) {',
+    '    funcb(i);',
+    '  };',
+    '  function funcb(i) {',
+    '    if ((i == 3)) {',
+    '    };',
+    '  };',
+    '  funcc(4);',
+    '};'
+    ]),
+    LinesToStr([
+    'this.funca();'
+    ])
+    );
+end;
+
+procedure TTestModule.TestAssignFunctionResult;
+begin
+  StartProgram(false);
+  Add('function F1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  i:=F1();');
+  Add('  i:=F1()+F1();');
+  ConvertProgram;
+  CheckSource('TestAssignFunctionResult',
+    LinesToStr([ // statements
+     'this.f1 = function () {',
+     '  var result = 0;',
+     '  return result;',
+     '};',
+     'this.i = 0;'
+    ]),
+    LinesToStr([
+    'this.i = this.f1();',
+    'this.i = (this.f1() + this.f1());'
+    ]));
+end;
+
+procedure TTestModule.TestFunctionResultInCondition;
+begin
+  StartProgram(false);
+  Add('function F1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('function F2: boolean;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  if F2 then ;');
+  Add('  if i=F1() then ;');
+  Add('  if i=F1 then ;');
+  ConvertProgram;
+  CheckSource('TestFunctionResultInCondition',
+    LinesToStr([ // statements
+     'this.f1 = function () {',
+     '  var result = 0;',
+     '  return result;',
+     '};',
+     'this.f2 = function () {',
+     '  var result = false;',
+     '  return result;',
+     '};',
+     'this.i = 0;'
+    ]),
+    LinesToStr([
+    'if (this.f2()) {',
+    '};',
+    'if ((this.i == this.f1())) {',
+    '};',
+    'if ((this.i == this.f1())) {',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestExit;
+begin
+  StartProgram(false);
+  Add('procedure ProcA;');
+  Add('begin');
+  Add('  exit;');
+  Add('end;');
+  Add('function FuncB: longint;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(3);');
+  Add('end;');
+  Add('function FuncC: string;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(''a'');');
+  Add('  exit(''abc'');');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestUnitImplVar',
+    LinesToStr([ // statements
+    'this.proca = function () {',
+    '  return;',
+    '};',
+    'this.funcb = function () {',
+    '  var result = 0;',
+    '  return result;',
+    '  return 3;',
+    '  return result;',
+    '};',
+    'this.funcc = function () {',
+    '  var result = "";',
+    '  return result;',
+    '  return "a";',
+    '  return "abc";',
+    '  return result;',
+    '};'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestUnitImplVars;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('var');
+  Add('  v1:longint;');
+  Add('  v2:longint = 3;');
+  Add('  v3:string = ''abc'';');
+  ConvertUnit;
+  CheckSource('TestUnitImplVar',
+    LinesToStr([ // statements
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;',
+    '$impl.v1 = 0;',
+    '$impl.v2 = 3;',
+    '$impl.v3 = "abc";'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestUnitImplConsts;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('const');
+  Add('  v1 = 3;');
+  Add('  v2:longint = 4;');
+  Add('  v3:string = ''abc'';');
+  ConvertUnit;
+  CheckSource('TestUnitImplVar',
+    LinesToStr([ // statements
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;',
+    '$impl.v1 = 3;',
+    '$impl.v2 = 4;',
+    '$impl.v3 = "abc";'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestUnitImplRecord;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('type');
+  Add('  TMyRecord = record');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('var r: TMyRecord;');
+  Add('initialization');
+  Add('  r.i:=3;');
+  ConvertUnit;
+  CheckSource('TestUnitImplVar',
+    LinesToStr([ // statements
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;',
+    '$impl.tmyrecord = function () {',
+    '  this.i = 0;',
+    '};',
+    '$impl.r = new $impl.tmyrecord();'
+    ]),
+    '$impl.r.i = 3;'
+    );
+end;
+
 procedure TTestModule.TestProcTwoArgs;
 begin
   StartProgram(false);
@@ -799,7 +1516,7 @@ begin
   CheckSource('TestVarRecord',
     LinesToStr([ // statements
     'this.treca = function () {',
-    '  b = 0;',
+    '  this.b = 0;',
     '};',
     'this.r = new this.treca();'
     ]),
@@ -923,7 +1640,7 @@ begin
     'this.i = 0;'
     ]),
     LinesToStr([ // this.$main
-    '  this.i = 1;',
+    'this.i = 1;',
     'if (i==1) {',
     'i=2;',
     '}',
@@ -944,6 +1661,141 @@ begin
   Add('    i:=3');
   Add('  end;');
   ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'try {',
+    '  this.i = 0;',
+    '  this.i = (2 / this.i);',
+    '} finally {',
+    '  this.i = 3;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOf;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1: ;');
+  Add('  2: i:=3;');
+  Add('  else');
+  Add('    i:=4');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $tmp1 = this.i;',
+    'if (($tmp1 == 1)) {} else if (($tmp1 == 2)) this.i = 3 else {',
+    '  this.i = 4;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOf_UseSwitch;
+begin
+  StartProgram(false);
+  Converter.UseSwitchStatement:=true;
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1: ;');
+  Add('  2: i:=3;');
+  Add('  else');
+  Add('    i:=4');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'switch (this.i) {',
+    'case 1:',
+    '  break;',
+    'case 2:',
+    '  this.i = 3;',
+    '  break;',
+    'default:',
+    '  this.i = 4;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfNoElse;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1: begin i:=2; i:=3; end;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $tmp1 = this.i;',
+    'if (($tmp1 == 1)) {',
+    '  this.i = 2;',
+    '  this.i = 3;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfNoElse_UseSwitch;
+begin
+  StartProgram(false);
+  Converter.UseSwitchStatement:=true;
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1: begin i:=2; i:=3; end;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'switch (this.i) {',
+    'case 1:',
+    '  this.i = 2;',
+    '  this.i = 3;',
+    '  break;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfRange;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1..3: i:=14;');
+  Add('  4,5: i:=16;');
+  Add('  6..7,9..10: ;');
+  Add('  else ;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $tmp1 = this.i;',
+    'if ((($tmp1 >= 1) && ($tmp1 <= 3))) this.i = 14 else if ((($tmp1 == 4) || ($tmp1 == 5))) this.i = 16 else if (((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10)))) {} else {',
+    '};'
+    ]));
 end;
 
 Initialization

packages/winunits-base/src/commctrl.pp

@@ -8414,7 +8414,7 @@ TYPE
 CONST
          MCN_GETDAYSTATE                = (MCN_FIRST + 3);
 
-// MCN_SELECT is sent whenever a selection has occured (via mouse or keyboard)
+// MCN_SELECT is sent whenever a selection has occurred (via mouse or keyboard)
 //
 TYPE
 

packages/winunits-base/src/dwmapi.pp

@@ -239,7 +239,7 @@ type
     cFramesAvailable: DWM_FRAME_COUNT;
 
     // number of rendered frames that were never
-    // displayed because composition occured too late
+    // displayed because composition occurred too late
     cFramesDropped: DWM_FRAME_COUNT;
 
     // number of times an old frame was composed

packages/winunits-jedi/src/jwaimagehlp.pas

@@ -2162,7 +2162,7 @@ type
 // The exception information stream contains the id of the thread that caused
 // the exception (ThreadId), the exception record for the exception
 // (ExceptionRecord) and an RVA to the thread context where the exception
-// occured.
+// occurred.
 //
 
   PMINIDUMP_EXCEPTION_STREAM = ^MINIDUMP_EXCEPTION_STREAM;

packages/winunits-jedi/src/jwawinbase.pas

@@ -1361,7 +1361,7 @@ const
   {$EXTERNALSYM EV_ERR}
   EV_RING     = $0100; // Ring signal detected
   {$EXTERNALSYM EV_RING}
-  EV_PERR     = $0200; // Printer error occured
+  EV_PERR     = $0200; // Printer error occurred
   {$EXTERNALSYM EV_PERR}
   EV_RX80FULL = $0400; // Receive buffer is 80 percent full
   {$EXTERNALSYM EV_RX80FULL}

packages/winunits-jedi/src/jwawinioctl.pas

@@ -2005,7 +2005,7 @@ type
 //                                                   //
 // The following structures define disk performance  //
 // statistics: specifically the locations of all the //
-// reads and writes which have occured on the disk.  //
+// reads and writes which have occurred on the disk.  //
 //                                                   //
 // To use these structures, you must issue an IOCTL_ //
 // DISK_HIST_STRUCTURE (with a DISK_HISTOGRAM) to    //

packages/winunits-jedi/src/jwawinwlx.pas

@@ -112,7 +112,7 @@ const
 //          DLL whether this constitutes a workstation locking event.
 //
 //      SCRNSVR_ACTIVITY - used to indicate that keyboard or mouse
-//          activity occured while a secure screensaver was active.
+//          activity occurred while a secure screensaver was active.
 //
 //      SC_INSERT - used to indicate that a smart card has been inserted
 //          to a compatible device